home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / zdisk.zip / ZDISK.PAS < prev   
Pascal/Delphi Source File  |  1991-04-18  |  4KB  |  153 lines
  1. {$I-}
  2. program zdisk;
  3. uses dos,crt,strnglib;
  4. label
  5.   finish;
  6. const
  7.   debug   = false;
  8.   bufsize = 32768;
  9.   smblk   = 512;
  10.   titleline = 2;
  11.   blkszline = 3;
  12.   statsline = 4;
  13.   msgline   = 5;
  14.   finishline= 10;
  15.   version   = '3.1';
  16. type
  17.   strng80 = string[80];
  18. var
  19.   buffer    : array[1..bufsize] of byte;
  20.   file0,
  21.   file1     : file;
  22.   blktitle  : string[20];
  23.   fname     : strng80;
  24.   status    : byte;
  25.  
  26.   function checkio(errmsg : strng80) : boolean;
  27.   var
  28.     iores : integer;
  29.   begin { checkio }
  30.     iores := ioresult;
  31.     if iores <> 0
  32.       then begin
  33.         writeln('IO Err # ',iores,'. ',errmsg);
  34.         checkio := true;
  35.       end
  36.       else begin
  37.         if debug
  38.           then begin
  39.             writeln(errmsg,' -- OK.');
  40.           end;
  41.         checkio := false;
  42.       end;
  43.   end; { checkio }
  44.  
  45.   function zerofile(var outfile : file; fn : strng80; bufsizeused : word)
  46.     : boolean;
  47.   var
  48.     can,
  49.     done          : boolean;
  50.     blockno       : longint;
  51.     blockswritten : integer;
  52.     ch            : char;
  53.     signature     : strng80;
  54.     i             : integer;
  55.   begin { zerofile }
  56.       gotoxy(1,blkszline);
  57.       clreol;
  58.       writeln('Writing in blocks of ',bufsizeused,' bytes to file ',fn);
  59.       gotoxy(1,statsline);
  60.       clreol;
  61.       write(blktitle);
  62.       zerofile := false; { not cancelled by operator }
  63.       { Create buffer to write to disk }
  64.       signature := 'ZDisk '+ version + ' was here.';
  65.       fillchar(buffer,sizeof(buffer),0);
  66.       for i := 1 to length(signature) do
  67.         buffer[i] := ord(signature[i]);
  68.       { open temporary output file }
  69.       assign(outfile,fn);
  70.       if checkio('assigning '+fn+' to temporary output file.')
  71.         then begin
  72.           zerofile := true;
  73.           exit;
  74.         end;
  75.       rewrite(outfile,bufsizeused);
  76.       if checkio('opening '+fn+'.')
  77.         then begin
  78.           zerofile := true;
  79.           exit;
  80.         end;
  81.       done := false;
  82.       blockno := 0;
  83.       ch := 'N'; { indicate no operator cancel }
  84.       repeat
  85.         blockwrite(outfile,buffer,1,blockswritten);
  86.         blockno := blockno + blockswritten;
  87.         if keypressed
  88.           then begin
  89.             { get rid of key which caused interruption }
  90.             ch := readkey;
  91.             if ch = #0
  92.               then ch := readkey;
  93.             gotoxy(1,msgline);
  94.             clreol;
  95.             write('Cancel ZDisk ? ');
  96.             ch := upcase(readkey);
  97.             write(ch);
  98.             gotoxy(1,msgline);
  99.             clreol;
  100.             done := ch = 'Y';
  101.             if done
  102.               then write('ZDisk cancelled by operator.')
  103.               else begin
  104.                 write('Press any key to cancel.');
  105.                 ch := 'N';
  106.               end;
  107.             zerofile := done;
  108.           end
  109.           else done := blockswritten = 0;
  110.         gotoxy(1+length(blktitle),statsline);
  111.         write(blockno:7);
  112.       until (done);
  113.       close(outfile);
  114.   end; { zerofile }
  115.  
  116. begin { zdisk }
  117.   if ParamCount > 0
  118.     then begin
  119.       fname := upcas(trim(Paramstr(1)));
  120.       if fname[1] in ['A'..'Z']
  121.         then fname := fname + ':\$Z$E$R$0.TMP'
  122.         else begin
  123.           writeln('ZDisk Version ',version,
  124.             ' Error -- Illegal Drive Parameter.');
  125.           halt(3);
  126.         end;
  127.     end
  128.     else fname := FExpand('\$Z$E$R$0.TMP');
  129.  
  130.   blktitle := 'Block No.: ';
  131.   status := 0; { Normal Termination }
  132.   clrscr;
  133.   gotoxy(1,titleline);
  134.   writeln('ZDisk ',version,
  135.           ' -- Overwrite unused sectors with binary zeroes.');
  136.   gotoxy(1,msgline);
  137.   clreol;
  138.   writeln('Press any key to cancel');
  139.   if zerofile(file0,fname,bufsize)
  140.     then begin
  141.       status := 1;
  142.       goto finish;
  143.     end;
  144.   fname[length(fname)-4] := '1';
  145.   if zerofile(file1,fname,smblk)
  146.     then status := 2;
  147. finish:
  148.   gotoxy(1,finishline);
  149.   clreol;
  150.   erase(file0);
  151.   erase(file1);
  152.   halt(status);
  153. end. { zdisk }